\ Timer routine for exercise Ham 12:00 11/01/92 \ This file contains a small program that will act as a \ timer for exercises involving timed repetitions. You \ set the timer for the number of seconds between beeps. \ A special beep occurs after every 10 repetitions. You \ can pause the timer and resume or escape. The timer \ also counts repetitions, both total and (for exercises \ involving arms and legs) "left" and "right." \ Enjoy. \ Michael Ham \ Santa Cruz, CA \ Conditional compilation Ham 12:00 11/01/92 FALSE EQU TURNKEY? \ change to TRUE to TURNKEY program \ To make a program, change the FALSE above to TRUE. Then exit \ the editor and execute COLD to remove the editor from memory. \ Then execute 1 LOAD. The program will load and automatically \ create the program files TIMER.EXE and TIMER.OVL. You execute \ the program by entering TIMER at the DOS prompt. 2 ?SCREENS THRU \ THRU is better than -->. THRU doesn't use up a line on every \ screen, and without -->, you can load individual screens \ during development. With -->, if you load one screen, you \ get it and also all the following screens. \ Cursor, pause messages Ham 12:00 11/01/92 : -CUR 79 24 GOTOXY ; \ put cursor away : CTR ( row adr -) SWAP >R COUNT 40 OVER 2/ - R> GOTOXY TYPE ; \ display string centered on specified row : +PAUSEMSG 36 20 GOTOXY BLINK 26 EMIT ." PAUSED" 27 EMIT -BLINK 22 " Press <Esc> to quit, any other key to continue" CTR -CUR ; : -PAUSEMSG 36 20 GOTOXY CLREOL 0 22 GOTOXY CLREOL -CUR ; WSIZE 2 = .IF 0 CONSTANT DOS0 .THEN \ for 16-bit : -CAPS DOS0 1047 C@L 191 AND DOS0 1047 C!L ; \ Caps-Lock off \ Display time Ham 12:00 11/01/92 : .0N ( n - ) 0 <# # # #> TYPE ; \ force two digits : .AM-PM @TIME DROP 256 /MOD 2DUP 0 12 D= IF 2DROP ." 12:00n " ELSE 2DUP 0 0 D= IF 2DROP ." 12:00m " ELSE DUP 11 > -ROT 12 MOD ?DUP 0= IF 12 THEN 2 .R ASCII : EMIT .0N IF ." p" ELSE ." a" THEN ." m" THEN THEN ; : .HOUR 0 24 GOTOXY .AM-PM -CUR ; \ put time of day on screen \ Exercise: revise .HOUR to put time at upper right corner. \ Exercise: revise .HOUR to show seconds as well. \ Tools: PCKEY, WAIT Ham 12:00 11/01/92 : PCKEY ( -- ASCII-char -1 | IBM-special_char 0 ) KEY ?DUP IF TRUE ELSE KEY FALSE THEN ; : @SECOND ( - second ) @TIME NIP 256 / ; \ get current second : WAIT @SECOND BEGIN DUP @SECOND <> ?TERMINAL OR UNTIL DROP ; ( if you're using WAIT repeatedly, that very ) ( first second may be short; after that, okay ) \ WAIT pauses until the second changes or a key is pressed, \ whichever comes first. \ NUF? variant Ham 12:00 11/01/92 27 CONSTANT ESC \ value of <Esc> key : NUF? ( - f ) ?TERMINAL DUP \ key pressed? IF PCKEY SWAP ESC = AND NOT \ and not <Esc> key? IF DROP +PAUSEMSG \ then pause BEGIN .HOUR WAIT ?TERMINAL UNTIL \ but keep clock going PCKEY -PAUSEMSG \ until key hit again -PAUSEMSG \ then zap message IF ESC = DUP NOT IF WAIT THEN \ if not <Esc>, wait ELSE WAIT DROP FALSE THEN THEN THEN ; \ A first <Esc> doesn't pause: it escapes immediately. \ Other keys pause for a second keystroke; if <Esc> is then \ pressed for the second keystroke, routine will escape then. \ Symbols to use for the march of time Ham 12:00 11/01/92 VARIABLE DONE \ to exit loop 10 CONSTANT DEFAULT \ default no. of seconds 24 CONSTANT #SYMBOLS \ no. of entries in STABLE 0 EQU SYMBOL \ used to pick symbol from table CREATE SUSE 24 ALLOT \ array of symbol usage : *USE SUSE 24 ERASE ; \ zap the symbol usage table CREATE STABLE 220 C, 11 C, 12 C, 6 C, 3 C, 4 C, 5 C, 19 C, 21 C, 127 C, 15 C, 13 C, 14 C, 232 C, 36 C, 157 C, 1 C, 43 C, 246 C, 30 C, 24 C, 25 C, 240 C, 236 C, \ Above table contains characters that look good as timer marks \ Pick next symbol at random Ham 12:00 11/01/92 : RANDOM ( n - n' ) @TIME * 32767 AND M* 32768 UM/MOD NIP ; \ RANDOM from FORTH.SCR, modified to use DOS time as seed. : #USED ( - n ) 0 #SYMBOLS 0 DO SUSE I + C@ IF 1+ THEN LOOP ; : NEWSYMBOL #USED #SYMBOLS = IF *USE THEN #SYMBOLS RANDOM BEGIN DUP SUSE + C@ WHILE 1+ #SYMBOLS MOD REPEAT DUP SUSE + 1 SWAP C! ( mark it as used ) STABLE + EQU SYMBOL ; \ NEWSYMBOL picks a symbol at random and then takes the first \ unused symbol it finds. This way all symbols are used before \ any are repeated, but each sequence is random. \ March of time Ham 12:00 11/01/92 \ This is the routine that displays the counting seconds and \ the march of symbols as each second ticks. : MARCH ( n -) 1- 10 MOD DUP 0= IF NEWSYMBOL THEN 2* 31 + 9 GOTOXY SYMBOL 1 TYPE ; \ Note TYPE is used; EMIT does odd things with some chars. : -MARCH 31 9 GOTOXY CLREOL ; \ to clear for new cycle of 10 : .SECS ( n - ) 34 7 GOTOXY DUP 3 .R ." second" DUP 1 = IF SPACE ELSE ." s" THEN MARCH ; \ I don't like programs that say "1 items" or "1 item(s)". \ SECONDS, beeps Ham 12:00 11/01/92 : SECONDS ( n - ) 0 DO I 1+ .SECS .HOUR WAIT NUF? IF DONE ON LEAVE THEN LOOP -MARCH ; \ SECONDS is the main wait loop: 8 SECONDS will wait for \ 8 seconds. Note that with NUF? the user can pause the loop \ and then resume or exit. SECONDS takes care of displaying \ the march of time with .SECS, which also updates time of day. : ERROR 440 15 BEEP ; \ beep for error : BURP 110 15 BEEP ; \ unobtrusive beep for reps : SQUEAK 880 15 BEEP ; \ high beep for every 10 reps \ #IN tools - for simple and robust # input Ham 12:00 11/01/92 TRUE CONSTANT BAD 13 CONSTANT ENTER 8 CONSTANT BSP : CAP ( c - C ) DUP ASCII ` > OVER ASCII { < AND IF BL - THEN ; : FIX# ( c - C) CAP DUP ASCII L = IF DROP ASCII 1 THEN \ L-> 1 DUP ASCII O = IF DROP ASCII 0 THEN ; \ O-> 0 : OK? ( c - f ) DUP ENTER = OVER BSP = OR OVER ESC = OR SWAP DUP ASCII 0 >= SWAP ASCII 9 <= AND OR ; \ or no.? \ OK? = 0 for all but number, <Enter>, <Backspace>, and <Esc> \ #IN Tools Ham 12:00 11/01/92 : ># ( c - n ) ASCII 0 - ; \ convert ASCII number to value : #WAIT 62 0 GOTOXY WAIT ; \ wait for next digit to arrive : .# ( n - ) 59 0 GOTOXY 3 .R ; : @# ( - c ) BEGIN BEGIN .HOUR #WAIT ?TERMINAL UNTIL PCKEY IF FIX# DUP OK? NOT ELSE BAD THEN WHILE DROP ERROR REPEAT ; \ @# leaves an ok character (a number of <Esc> or <Enter> or \ or <Backspace> on the stack. As usual, L and l are converted \ to 1, and O and o are converted to 0. \ #IN, a small but good number-input word Ham 12:00 11/01/92 : #IN 0 BEGIN @# CASE ( 4 cases: <Enter> <Bsp> <Esc> or no. ) ENTER OF TRUE ( got the number: leave ) ENDOF BSP OF DUP IF 10 / ( zap unit's digit ) DUP .# ( and display result ) ELSE ERROR ( if number is 0 ) THEN FALSE ( don't leave ) ENDOF ESC OF DONE ON ( quitting ) TRUE ( leave ) ENDOF ( if it gets here, must be a no. ) ># OVER 99 > IF ERROR DROP ( won't allow 4-digit numbers ) ELSE SWAP 10 * + ( tack on unit's digit ) DUP .# ( and display ) THEN 0. ( one 0 for ENDCASE to drop and one for UNTIL ) ENDCASE UNTIL ; \ Collect the interval duration Ham 12:00 11/01/92 : GET-INTERVAL ( - n ) 18 0 GOTOXY ." Every how many seconds? (default is " DEFAULT 0 .R ." )" #IN DUP 1 < IF DROP DEFAULT DUP .# THEN ; ( Notice that the cursor is not tucked away during the number ) ( input: we want to make it visible so the user will know to ) ( enter the number. ) : .PMSG 3 " Press <Esc> to quit, any other key to pause" CTR ; : *ROW ( row - ) 0 SWAP GOTOXY CLREOL ; ( zap row; avoid CLS because it looks bad on CGA displays ) \ Heart of the routine Ham 12:00 11/01/92 : .REPS ( n - ) DUP 34 14 GOTOXY ." Total Reps" 4 .R DUP 2 /MOD + 27 17 GOTOXY ." Left" 4 .R 2/ 48 17 GOTOXY ." Right" 4 .R SPACE ; : RUN DONE OFF GET-INTERVAL DONE @ NOT IF WAIT ( short second ) .PMSG 0 ( rep no. ) BEGIN DUP .REPS 1+ OVER SECONDS DONE @ DUP NOT IF BURP OVER 10 MOD 0= IF SQUEAK THEN THEN UNTIL 2DROP THEN 0 *ROW 3 *ROW 7 *ROW 14 *ROW 17 *ROW ; ( double beep every 10 repetitions; initial WAIT takes ) ( care of possibly short first second; do only if DONE ) ( still off after GET-INTERVAL ) \ Y/N word Ham 12:00 11/01/92 0. 2EQU XY \ for xy coordinates : @KEY ( - c ) BEGIN BEGIN .HOUR XY GOTOXY WAIT ?TERMINAL UNTIL PCKEY NOT WHILE DROP ERROR REPEAT ; \ keep clock running : FIXLTR ( char - CHAR ) CAP DUP ESC = IF DROP ASCII N THEN ; : ECHO ( n - n ) DUP BL >= IF DUP XY GOTOXY EMIT THEN ; : Y/N ( - flag ) ." (Y/N)? " ?XY 2EQU XY BEGIN @KEY FIXLTR ECHO DUP ASCII Y <> OVER ASCII N <> AND WHILE DROP ERROR REPEAT DUP XY GOTOXY EMIT ASCII Y = ; \ Title routine and copyright notice Ham 12:00 11/01/92 : TITLE -CAPS 1 BACKGROUND INTENSITY CLS 1 " Little Timer" CTR 3 " Version 1.0" CTR 6 " For exercises like Yoga and stretching, where" CTR 7 " you must hold each position for x seconds. " CTR 10 " Written in Laboratory Microsystem's UR/FORTH." CTR 20 " Copyright (C) 1990 by Michael Ham" CTR 24 " Press any key to begin." CTR -CUR PCKEY 2DROP ; ' TITLE vIDENT ! \ set up title for TURNKEY : STOP? ( - flag ) 24 5 GOTOXY ." Want to do more timings " Y/N NOT 24 5 GOTOXY CLREOL ; \ Copyright notice and final routine Ham 12:00 11/01/92 : CNOTE \ Copyright notice to appear in the object code " Forth nucleus Copyright (C) 1987 Laboratory Microsystems, Inc., Los Angeles, CA " ; : }BYE TURNKEY? IF BYE THEN ; \ Use BYE for compiled version : TIMER CLS *USE BEGIN RUN STOP? UNTIL B/W CLS }BYE ; \ Note that a TURNKEYed program *>must<* end with BYE. TURNKEY? .IF TURNKEY TIMER TIMER .THEN
